home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / faq-s.zip / INIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-04  |  16KB  |  664 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. {$DEFINE OVERLAY}
  5.  
  6. unit init;
  7.  
  8. interface
  9.  
  10. uses crt,dos,filexfer,
  11.      gentypes,modem,statret,configrt,gensubs,subs1,windows,subs2;
  12.  
  13. procedure validconfiguration;
  14. procedure initboard (checkfiles30:boolean);
  15.  
  16. implementation
  17.  
  18. procedure validconfiguration;
  19. var errs:integer;
  20.     cnt:integer;
  21.     flag:boolean;
  22.  
  23.   procedure error (q:anystr);
  24.   begin
  25.     if errs=0 then writeln (usr,'Setup Errors:');
  26.     errs:=errs+1;
  27.     writeln (usr,errs,'. ',q)
  28.   end;
  29.  
  30.   procedure ispath (var x:lstr; name:lstr);
  31.   begin
  32.     if not exist(x+'con') then begin
  33.     writeln (usr,'Path bad: '+x+' - Creating.');
  34.     mkdir (copy(x,1,length(x)-1))
  35.    end;
  36.   end;
  37.  
  38.   procedure isfilename (var xx:lstr; fn:lstr);
  39.   begin
  40.    if not exist(xx) then error (fn+' Filename bad: '+xx)
  41.   end;
  42.  
  43.   procedure isstring (x:anystr; name:lstr);
  44.   var cnt:integer;
  45.   begin
  46.     if length(x)=0 then begin
  47.       error (name+' has not been set!');
  48.       exit
  49.     end;
  50.     for cnt:=1 to length(x) do if not (x[cnt] in [#32..#255])
  51.       then begin
  52.         error ('Bad '+name+' string');
  53.         exit
  54.       end
  55.   end;
  56.  
  57.   procedure isinteger (n,r1,r2:integer; name:lstr);
  58.   begin
  59.   if (n<r1) or (n>r2) then error ('Bad '+name+' value: '+strr(n));
  60.   end;
  61.  
  62.   procedure islongint (n,r1,r2:longint; name:lstr);
  63.   begin
  64.   if (n<r1) or (n>r2) then error ('Bad '+name+' value: '+strr(n));
  65.   end;
  66.  
  67.   procedure dothat (name:lstr);
  68.   begin
  69.   if not exist (faqdir+name) then begin errs:=errs+1;
  70.   writeln (usr,errs,'. '+name+' does not exist!'); end;
  71.   end;
  72.  
  73. begin
  74.   errs:=0;
  75.   ispath (textdir,'Path to Message Base');
  76.   ispath (uploaddir,'Path to Ascii Uploads');
  77.   ispath (datadir,'Path to Xfer and Data Files');
  78.   ispath (textfiledir,'Path to Menus, etc.');
  79.   ispath (doordir,'Path to DOOR Batch Files');
  80.   ispath (networkdir,'Path to Network Files');
  81.   ispath (bbsdatadir,'Path to BBS Data Files');
  82.   ispath (xferdir,'Path to Xfer Uploads');
  83.   isstring (sysopname,'Sysop Name');
  84.   islongint (defbaudrate,300,38400,'default Baud Rate');
  85.   isinteger (usecom,1,4,'COM Port');
  86.   isinteger (mintimeout,1,maxint,'input time out');
  87.   isinteger (sysoplevel,1,maxint,'Co-Sysop Level');
  88.   if (not exist (faqdir+'DSZ.COM')) and (not exist (faqdir+'DSZ.EXE')) then begin
  89.   errs:=errs+1; writeln (usr,errs,'. DSZ.COM and DSZ.EXE do not exist!'); end;
  90.   dothat ('PKZIP.EXE');
  91.   dothat ('PKUNZIP.EXE');
  92.   if (sblaster) and not (exist (faqdir+'VPLAY.EXE')) then begin errs:=errs+1;
  93.   writeln (usr,errs,'. VPLAY.EXE does not exist!'); end;
  94.   if not exist (faqdir+'REGISTER.DAT') then begin errs:=errs+1;
  95.   writeln (usr,errs,'. REGISTER.DAT does not exist!');
  96.   end else begin
  97.   assign (regsfile,faqdir+'REGISTER.DAT');
  98.   reset (regsfile);
  99.   seek (regsfile,0);
  100.   read (regsfile,reg);
  101.   if (not match(sysopname,reg.handle)) then begin errs:=errs+1; writeln (usr,errs,'. Not Registered to Sysop!'); end;
  102.   end;
  103.   flag:=true;
  104.   for cnt:=1 to 100 do if flag and (usertime[cnt]<1) then begin
  105.     flag:=false;
  106.     error ('Time per day has non-positive entries')
  107.   end;
  108.   if errs>0 then begin
  109.   halt (e_badconfig);
  110.  end;
  111. end;
  112.  
  113. procedure initboard (checkfiles30:boolean);
  114.  
  115.   procedure formatmfile;
  116.   var m:mailrec;
  117.   begin
  118.     rewrite (mfile);
  119.     fillchar (m,sizeof(m),255);
  120.     write (mfile,m)
  121.   end;
  122.  
  123.   procedure openmfile;
  124.   var i:integer;
  125.   begin
  126.     i:=ioresult;
  127.     assign (mfile,bbsdatadir+'Mail.dat');
  128.     close (mfile);
  129.     reset (mfile);
  130.     i:=ioresult;
  131.     if i<>0
  132.       then if i=2
  133.         then formatmfile
  134.         else begin
  135.           writeln (usr,'Fatal error: Unable to open mail file!');
  136.           halt (e_fatalfileerror)
  137.         end
  138.   end;
  139.  
  140.   procedure closetfile;
  141.   var n:integer;
  142.   begin
  143.     close (tfile);
  144.     n:=ioresult;
  145.     close (mapfile);
  146.     n:=ioresult
  147.   end;
  148.  
  149.   procedure formattfile;
  150.   var cnt,p:integer;
  151.       r:real;
  152.       buff:buffer;
  153.       x:string[1];
  154.   const dummystr:sstr='Blank!! ';
  155.   begin
  156.     rewrite (mapfile);
  157.     if ioresult<>0 then begin
  158.       writeln (usr,'Unable to create Message Base.');
  159.       halt (e_fatalfileerror)
  160.     end;
  161.     p:=-2;
  162.     for cnt:=0 to numsectors do write (mapfile,p);
  163.     p:=1;
  164.     for cnt:=1 to sectorsize do begin
  165.       buff[cnt]:=dummystr[p];
  166.       p:=p+1;
  167.       if p>length(dummystr) then p:=1
  168.     end;
  169.     rewrite (tfile);
  170.     if ioresult<>0 then begin
  171.       writeln (usr,'Unable to create Message Base.');
  172.       halt (e_fatalfileerror)
  173.     end;
  174.     for cnt:=0 to 5 do write (tfile,buff)
  175.   end;
  176.  
  177.   procedure opentfile;
  178.   var i,j:integer;
  179.   begin
  180.     assign (tfile,textdir+'Text');
  181.     assign (mapfile,textdir+'BlockMap');
  182.     closetfile;
  183.     reset (tfile);
  184.     i:=ioresult;
  185.     reset (mapfile);
  186.     j:=ioresult;
  187.     if (i<>0) or (j<>0) then formattfile;
  188.     firstfree:=-1
  189.   end;
  190.  
  191.   procedure openufile;
  192.   var u:userrec;
  193.       n,cnt:integer;
  194.  
  195.     procedure createuhfile;
  196.     var cnt:integer;
  197.     begin
  198.       rewrite (uhfile);
  199.       if ioresult<>0 then begin
  200.         writeln (usr,'Unable to create the User Index File, run FAQ Again.');
  201.         halt (e_fatalfileerror)
  202.       end;
  203.       seek (ufile,0);
  204.       while not eof(ufile) do begin
  205.         read (ufile,u);
  206.         write (uhfile,u.handle)
  207.       end
  208.     end;
  209.  
  210.   begin
  211.     assign (ufile,bbsdatadir+'Users.Dat');
  212.     close (ufile);
  213.     reset (ufile);
  214.     n:=ioresult;
  215.     if n=0 then begin
  216.       numusers:=filesize(ufile)-1;
  217.       assign (uhfile,bbsdatadir+'UserIndx.Dat');
  218.       close (uhfile);
  219.       reset (uhfile);
  220.       if ioresult<>0
  221.         then createuhfile
  222.         else if filesize(uhfile)<>filesize(ufile) then begin
  223.           close (uhfile);
  224.           createuhfile
  225.         end;
  226.       exit
  227.     end;
  228.     close (ufile);
  229.     n:=ioresult;
  230.     rewrite (ufile);
  231.     fillchar (u,sizeof(u),0);
  232.     write (ufile,u);
  233.     u.handle:=sysopname;
  234.     u.defproto:='Z';
  235.     u.note:='SysOp';
  236.     u.realname:='';
  237.     u.sex:='';
  238.     u.age:=0;
  239.     u.citystate:='';
  240.     u.country:='';
  241.     u.zipcode:='';
  242.     if length(confm[1])>0 then u.defcon[1]:=true;
  243.     if length(confm[2])>0 then u.defcon[2]:=true;
  244.     if length(confm[3])>0 then u.defcon[3]:=true;
  245.     if length(confm[4])>0 then u.defcon[4]:=true;
  246.     if length(confm[5])>0 then u.defcon[5]:=true;
  247.     if length(confx[1])>0 then u.defcon[6]:=true;
  248.     if length(confx[2])>0 then u.defcon[7]:=true;
  249.     if length(confx[3])>0 then u.defcon[8]:=true;
  250.     if length(confx[4])>0 then u.defcon[9]:=true;
  251.     if length(confx[5])>0 then u.defcon[10]:=true;
  252.     u.macro1:=u.handle;
  253.     u.macro2:=longname;
  254.     u.macro3:='';
  255.     u.password:='FAQ';
  256.     u.phonenum:='1234567890';
  257.     u.timetoday:=1000;
  258.     u.level:=sysoplevel+1;
  259.     u.udlevel:=sysoplevel+1;
  260.     u.udpoints:=sysoplevel+1;
  261.     u.gflevel:=sysoplevel+1;
  262.     u.laston:=now;
  263.     u.config:=[lowercase,eightycols,linefeeds,postprompts,asciigraphics,ansigraphics,showtime];
  264.     u.emailannounce:=-1;
  265.     u.infoform1:=-1;
  266.     u.infoform2:=-1;
  267.     u.infoform3:=-1;
  268.     u.infoform4:=-1;
  269.     u.infoform5:=-1;
  270.     u.displaylen:=25;
  271.     u.regularcolor:=defcolor2;
  272.     u.statcolor:=defcolor3;
  273.     u.inputcolor:=defcolor4;
  274.     u.promptcolor:=defcolor1;
  275.     u.bordercolor:=defcolor5;
  276.     u.bstatuscolor:=defcolor6;
  277.     u.menutype:=0;
  278.     u.laston:=now;
  279.     fillchar (u.access2,32,255);
  280.     if useconmode then u.config:=u.config+[ansigraphics,fseditor];
  281.     write (ufile,u);
  282.     numusers:=1;
  283.     createuhfile
  284.   end;
  285.  
  286.   procedure initfile (var f:file);
  287.   var fi:fib absolute f;
  288.   begin
  289.     fi.handle:=0;
  290.     fi.name[0]:=chr(0)
  291.   end;
  292.  
  293.   procedure openlogfile;
  294.  
  295.     procedure autodeletesyslog;
  296.     var mx,cnt:integer;
  297.         l:logrec;
  298.     begin
  299.       dontanswer;
  300.       write (usr,'Auto-deleting System Log - please stand by.');
  301.       mx:=filesize(logfile) div 2;
  302.       for cnt:=1 to mx do begin
  303.         seek (logfile,cnt+mx-1);
  304.         read (logfile,l);
  305.         seek (logfile,cnt-1);
  306.         write (logfile,l)
  307.       end;
  308.       seek (logfile,mx-1);
  309.       truncate (logfile);
  310.       writeln (usr,'Done.');
  311.       doanswer
  312.     end;
  313.  
  314.   begin
  315.     assign (logfile,bbsdatadir+'Syslog.dat');
  316.     close (logfile);
  317.     reset (logfile);
  318.     if ioresult<>0 then begin
  319.       rewrite (logfile);
  320.       if ioresult<>0 then begin
  321.         writeln (usr,'Unable to create log file');
  322.         halt (e_fatalfileerror)
  323.       end
  324.     end;
  325.     if filesize(logfile)>maxsyslogsize then autodeletesyslog
  326.   end;
  327.  
  328.   procedure loadsyslogdat;
  329.   var tf:text;
  330.       q:lstr;
  331.       b1,b2,p,s,n:integer;
  332.   begin
  333.     numsyslogdat:=0;
  334.     with syslogdat[0] do begin
  335.       menu:=0;
  336.       subcommand:=0;
  337.       text:='Entry Not Found: %'
  338.     end;
  339.     assign (tf,'syslog.faq');
  340.     reset (tf);
  341.     if ioresult=0 then begin
  342.       while not eof(tf) do begin
  343.         readln (tf,q);
  344.         p:=pos(' ',q);
  345.         if p<>0 then begin
  346.           val (copy(q,1,p-1),b1,s);
  347.           if s=0 then begin
  348.             delete (q,1,p);
  349.             p:=pos(' ',q);
  350.             if p<>0 then begin
  351.               val (copy(q,1,p-1),b2,s);
  352.               if s=0 then begin
  353.                 delete (q,1,p);
  354.                 if numsyslogdat=maxsyslogdat
  355.                   then writeln (usr,'Too many SYSLOG.FAQ entries')
  356.                   else begin
  357.                     numsyslogdat:=numsyslogdat+1;
  358.                     with syslogdat[numsyslogdat] do begin
  359.                       menu:=b1;
  360.                       subcommand:=b2;
  361.                       text:=copy(q,1,30)
  362.                     end
  363.                   end
  364.               end
  365.             end
  366.           end
  367.         end
  368.       end;
  369.       textclose (tf)
  370.     end;
  371.     if numsyslogdat=0 then writeln (usr,'SYSLOG.FAQ file missing or invalid')
  372.   end;
  373.  
  374.   procedure doesfilesequal30;
  375.   var f:array [1..14] of file;
  376.       cnt,i:integer;
  377.   begin
  378.     {$IFNDEF OVERLAY}
  379.     for cnt:=1 to 14 do begin
  380.       assign (f[cnt],'CON');
  381.       reset (f[cnt]);
  382.       i:=ioresult;
  383.       if i<>0 then begin
  384.         writeln (usr,^M^G^J'ERROR:  FILES=30 must be placed in your CONFIG.SYS');
  385.         halt (e_files40)
  386.       end
  387.     end;
  388.     for cnt:=14 downto 1 do close(f[cnt])
  389.     {$ENDIF}
  390.   end;
  391.  
  392. procedure readsysopmacros;
  393. var ff:text;
  394.     ummbobway,killer:integer;
  395. begin
  396.  assign (ff,faqdir+'SYSOP.MAC');
  397.  ummbobway:=0;
  398.  if not exist (faqdir+'SYSOP.MAC') then begin
  399.   sysopmacro1:=sysopname;
  400.   sysopmacro2:=longname;
  401.   sysopmacro3:='Sysop Macro #3';
  402.   sysopmacro4:='Sysop Macro #4';
  403.   sysopmacro5:='Sysop Macro #5';
  404.   sysopmacro6:='Sysop Macro #6';
  405.   sysopmacro7:='Sysop Macro #7';
  406.   sysopmacro8:='Sysop Macro #8';
  407.   sysopmacro9:='Sysop Macro #9';
  408.   sysopmacro10:='Sysop Macro #10';
  409.  end else
  410.  if exist (faqdir+'SYSOP.MAC') then begin
  411.   reset (ff);
  412.   readln (ff,sysopmacro1);
  413.   readln (ff,sysopmacro2);
  414.   readln (ff,sysopmacro3);
  415.   readln (ff,sysopmacro4);
  416.   readln (ff,sysopmacro5);
  417.   readln (ff,sysopmacro6);
  418.   readln (ff,sysopmacro7);
  419.   readln (ff,sysopmacro8);
  420.   readln (ff,sysopmacro9);
  421.   readln (ff,sysopmacro10);
  422.   close (ff);
  423.  end
  424. end;
  425.  
  426. procedure faq;
  427.  
  428. procedure faqone;
  429. var
  430. i:integer;
  431. begin
  432. for i:=21 downto 0 do begin
  433. textcolor(15);
  434. gotoxy(20,1+i);write(usr,'       ────────────────────       ');
  435. gotoxy(20,2+i);clreol;
  436. delay(10);
  437. end;
  438. end;
  439.  
  440. procedure faqtwo;
  441. var
  442. i:integer;
  443. begin
  444. for i:=21 downto 0 do begin
  445. textcolor(1);
  446. gotoxy(27,2+i);write(usr,'██████');
  447. gotoxy(27,3+i);write(usr,'██    ');
  448. gotoxy(27,4+i);write(usr,'██    ');
  449. gotoxy(27,5+i);write(usr,'████  ');
  450. gotoxy(27,6+i);write(usr,'██    ');
  451. gotoxy(27,7+i);write(usr,'██    ');
  452. gotoxy(27,8+i);write(usr,'██    ');
  453. gotoxy(27,9+i);clreol;
  454. delay(10);
  455. end;
  456. end;
  457.  
  458. procedure faqthree;
  459. var
  460. i:integer;
  461. begin
  462. for i:=21 downto 0 do begin
  463. textcolor(9);
  464. gotoxy(34,2+i);write(usr,' ████ ');
  465. gotoxy(34,3+i);write(usr,'██  ██');
  466. gotoxy(34,4+i);write(usr,'██  ██');
  467. gotoxy(34,5+i);write(usr,'██  ██');
  468. gotoxy(34,6+i);write(usr,'██  ██');
  469. gotoxy(34,7+i);write(usr,'██████');
  470. gotoxy(34,8+i);write(usr,'██  ██');
  471. gotoxy(34,9+i);clreol;
  472. delay(10);
  473. end;
  474. end;
  475.  
  476. procedure faqfour;
  477. var
  478. i:integer;
  479. begin
  480. for i:=21 downto 0 do begin
  481. textcolor(11);
  482. gotoxy(41,2+i);write(usr,' ████ ');
  483. gotoxy(41,3+i);write(usr,'██  ██');
  484. gotoxy(41,4+i);write(usr,'██  ██');
  485. gotoxy(41,5+i);write(usr,'██  ██');
  486. gotoxy(41,6+i);write(usr,'██  ▀█');
  487. gotoxy(41,7+i);write(usr,'██ █▄ ');
  488. gotoxy(41,8+i);write(usr,' ███▀█');
  489. gotoxy(41,9+i);clreol;
  490. delay(10);
  491. end;
  492. end;
  493.  
  494. procedure faqfive;
  495. var
  496. i:integer;
  497. begin
  498. for i:=21 downto 0 do begin
  499. textcolor(15);
  500. gotoxy(20,9+i);write(usr,'       ────────────────────       ');
  501. gotoxy(20,10+i);clreol;
  502. delay(10);
  503. end;
  504. end;
  505.  
  506. procedure faqsix;
  507. var
  508. i:integer;
  509. begin
  510. for i:=21 downto 0 do begin
  511. textcolor(11);
  512. gotoxy(27,10+i);write(usr,'  by The Firegod  ');
  513. gotoxy(27,11+i);clreol;
  514. gotoxy(27,11+i+1);clreol;
  515. delay(20);
  516. end;
  517. end;
  518.  
  519. begin
  520. faqone;
  521. faqtwo;
  522. faqthree;
  523. faqfour;
  524. faqfive;
  525. faqsix;
  526. end;
  527.  
  528. var k,klux:char;
  529.     cnt:integer;
  530.     result:word;
  531. begin
  532.   with textrec(system.output) do begin
  533.     openfunc:=@opendevice;
  534.     closefunc:=@closedevice;
  535.     flushfunc:=@writechars;
  536.     inoutfunc:=@writechars
  537.   end;
  538.   with textrec(system.input) do begin
  539.     inoutfunc:=@readcharfunc;
  540.     openfunc:=@ignorecommand;
  541.     closefunc:=@ignorecommand;
  542.     flushfunc:=@ignorecommand
  543.   end;
  544.   if checkfiles30 then doesfilesequal30;
  545.   fillchar (urec,sizeof(urec),0);
  546.   urec.config:=[lowercase,eightycols,asciigraphics,ansigraphics];
  547.   iocode:=0;
  548.   linecount:=0;
  549.   sysopavail:=bytime;
  550.   errorparam:='';
  551.   errorproc:='';
  552.   unam:='';
  553.   chainstr:='';
  554.   chatreason:='';
  555.   sendstr:='';
  556.   ulvl:=0;
  557.   unum:=-1;
  558.   logonunum:=-2;
  559.   echoit:=true;
  560.   break:=false;
  561.   atmenu:=false;    { if you're at a menu or not }
  562.   nochain:=false;   { doesn't continue with other write's etc.. }
  563.   nobreak:=true;    { false before... }
  564.   wordwrap:=false;  { does the wrapping of words to the next line }
  565.   beginwithspacesok:=false;
  566.   echodot:=false;
  567.   online:=false;
  568.   local:=true;
  569.   chatmode:=false;
  570.   texttrap:=false;
  571.   printerecho:=false;
  572.   fillchar (urec,sizeof(urec),0);
  573.   usecapsonly:=false;
  574.   uselinefeeds:=true;
  575.   curattrib:=0;
  576.   buflen:=80;
  577.   baudrate:=defbaudrate;
  578.   parity:=false;
  579.   statusbar:=false;
  580.   timelock:=false;
  581.   ingetstr:=false;
  582.   modeminlock:=false;
  583.   modemoutlock:=false;
  584.   tempsysop:=false;
  585.   sysnext:=false;
  586.   forcehangup:=false;
  587.   requestbreak:=false;
  588.   disconnected:=false;
  589.   bsent:=0; brecv:=0;
  590.   notitle:=false;
  591.   nosendprompt:=false;
  592.   emailing:=false;
  593.   periods:=false;
  594.   validprotos:=['X','Y','Z','J','L','G','O','1','S','K','R','P','W','4'];
  595.   cursection:=mainsysop;
  596.   regularlevel:=0;
  597.   if paramcount=1 then usecom:=2;
  598.   setparam (usecom,baudrate,parity);
  599.   doanswer;
  600.   initwinds;
  601.   for cnt:=1 to numsysfiles do initfile (sysfiles[cnt]);
  602.   window (1,1,80,25);
  603.   cursor (false);
  604.   clrscr;
  605.   for cnt:=1 to 25 do begin
  606.   gotoxy (1,cnt);
  607.   clreol;
  608.   end;
  609.   gotoxy (1,1);
  610.   cursor (true);
  611.   loadsyslogdat;
  612.   readstatus;
  613.   openufile;
  614.   opentfile;
  615.   openlogfile;
  616.   openmfile;
  617.   readsysopmacros;
  618. end;
  619.  
  620. procedure assignname (var t:text; nm:lstr);
  621. begin
  622.   with textrec(t) do begin
  623.     move (nm[1],name,length(nm));
  624.     name[length(nm)]:=#0
  625.   end
  626. end;
  627.  
  628. var r:registers;
  629. begin
  630.   checkbreak:=false;
  631.   checkeof:=false;
  632.   directvideo:=directvideomode;
  633.   checksnow:=checksnowmode;
  634.   r.ah:=15;
  635.   intr ($10,r);
  636.   if r.al=7
  637.     then screenseg:=$b000
  638.     else screenseg:=$b800;
  639.   textrec(system.input).mode:=fminput;
  640.   move (output,usr,sizeof(text));           { Set up device drivers }
  641.   move (output,direct,sizeof(text));
  642.   move (system.input,directin,sizeof(text));
  643.   with textrec(direct) do begin
  644.     openfunc:=@opendevice;
  645.     closefunc:=@closedevice;
  646.     flushfunc:=@directoutchars;
  647.     inoutfunc:=@directoutchars;
  648.     bufptr:=@buffer
  649.   end;
  650.   with textrec(directin) do begin
  651.     mode:=fminput;
  652.     inoutfunc:=@directinchars;
  653.     openfunc:=@ignorecommand;
  654.     flushfunc:=@ignorecommand;
  655.     closefunc:=@ignorecommand;
  656.     bufptr:=@buffer
  657.   end;
  658.   with textrec(usr) do bufptr:=@buffer;
  659.   assignname (usr,'USR');
  660.   assignname (direct,'DIRECT');
  661.   assignname (directin,'DIRECT-IN');
  662.   assignname (system.output,'OUTPUT');
  663.   assignname (system.input,'INPUT')
  664. end.